home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
forth
/
hence4th.lha
/
hence4th
/
words2.m4
< prev
next >
Wrap
Text File
|
1993-02-02
|
4KB
|
149 lines
dnl WARNING: This file is part of the Hence4th Development System
dnl DO NOT REDISTRIBUTE!
dnl
dnl
dnl HenceFORTH in C
dnl (c) Copyright 1990 MISSING LINK
dnl All Rights Reserved
dnl
dnl
dnl File: words2.m4
dnl Desc: Forth secondary definitions
dnl
dnl
Include(`m4header')
cinclude("words2.h")
Linkto(dashdup)
nucleus
Word(`traverse',,`SWAP BEGIN OVER PLUS LIT(0x7F) OVER CFETCH LESS UNTIL
SWAP DROP')
Word(`latest',,`CURRENT FETCH FETCH')
Word(`lfa',,`LIT( 2 * sizeof(a_cell)) SUBTRACT')
Word(`cfa',,`LIT(sizeof(a_cell)) SUBTRACT')
Word(`nfa',,`LIT(2 * sizeof(a_cell) + 1) SUBTRACT LIT(-1) TRAVERSE')
Word(`pfa',,`ONE TRAVERSE LIT(2 * sizeof(a_cell) + 1) PLUS ALIGN')
Word(`storecsp',`!csp',`SPFETCH CSP STORE')
Word(`qerror',`?error',`SWAP IF ERROR ELSE DROP ENDIF')
Word(`qcomp',`?comp',`STATE FETCH ZEROEQUALS LIT(0x11) QERROR')
Word(`qexec',`?exec',`STATE FETCH LIT(0x12) QERROR')
Word(`qpairs',`?pairs',`SUBTRACT LIT(0x13) QERROR')
Word(`qcsp',`?csp',`SPFETCH CSP FETCH SUBTRACT LIT(0x14) QERROR')
Word(`qloading',`?loading',`BLK FETCH ZEROEQUALS LIT(0x16) QERROR')
Word(`compile',,`QCOMP LIT(ip) DUP LIT(sizeof(a_cell)) PLUS
ip = (char *) pop; FETCH COMMA')
compilers
Word(`leftbracket',`[',`ZERO STATE STORE')
nucleus
Word(`rightbracket',`]',`LIT(0xC0) STATE STORE')
Word(`smudge',,`LATEST LIT(0x20) TOGGLE')
Word(`hex',,`LIT(0x10) BASE STORE')
Word(`decimal',,`LIT(10) BASE STORE')
Word(`psemicode',`\050;code\051',`push(ip); LATEST PFA CFA STORE SEMIS')
Word(`semicode',`;code',`QCSP COMPILE(psemicode) /*[COMPILE]*/ LEFTBRACKET')
Word(`builds',`<builds',`ZERO CONSTANT')
nucleus
Word(`does',`does>',`push(ip); LATEST PFA STORE SEMICODE(dodoes) SEMIS')
Word(`count',,`DUP ONEPLUS SWAP CFETCH')
Word(`dashtrailing',`-trailing',`DUP ZERO DO OVER OVER PLUS ONE SUBTRACT
CFETCH BL SUBTRACT IF LEAVE ELSE ONE SUBTRACT ENDIF LOOP')
Word(`pdotquote',`\050.\"\051',`LIT(ip) COUNT DUP ONEPLUS
LIT(ip) PLUS ALIGN ip = (char *)pop; TYPE')
compilers
Word(`dotquote',`.\"',`LIT(0x22) STATE FETCH IF COMPILE(pdotquote)
WORD HERE CFETCH ONEPLUS ALLOT HERE ALIGN DP STORE
ELSE WORD HERE COUNT TYPE ENDIF')
nucleus
Word(`expect',,`OVER PLUS OVER DO KEY DUP LIT(0X0E) PLUSORIGIN FETCH
EQUALS IF DROP LIT(8) OVER I EQUALS DUP RFROM TWO SUBTRACT
PLUS TOR SUBTRACT ELSE DUP LIT(EOL) EQUALS IF LEAVE DROP
BL ZERO ELSE DUP ENDIF I CSTORE ZERO I ONEPLUS CSTORE ZERO
I TWOPLUS CSTORE ENDIF EMIT LOOP DROP')
Word(`query',,`TIB FETCH LIT(0x50) EXPECT ZERO IN STORE')
compilers
Word(`null',`\000',`BLK FETCH IF ONE BLK PLUSSTORE ZERO IN STORE
BLK FETCH LIT(1024 / BPERBUF - 1) AND ZEROEQUALS IF QEXEC
/* RFROM DROP */ SEMIS ENDIF ELSE /* RFROM DROP */ SEMIS ENDIF')
nucleus
Word(`fill',,`SWAP TOR OVER CSTORE DUP ONEPLUS RFROM ONE SUBTRACT CMOVE')
Word(`erasee',`erase',`ZERO FILL')
Word(`blanks',,`BL FILL')
Word(`hold',,`LIT(-1) HLD PLUSSTORE HLD FETCH CSTORE')
Word(`pad',,`HERE LIT(0X44) PLUS')
Word(`word',,`BLK FETCH IF BLK FETCH BLOCK ELSE TIB FETCH ENDIF
IN FETCH PLUS SWAP ENCLOSE HERE LIT(0X22) BLANKS
IN PLUSSTORE OVER SUBTRACT TOR R HERE CSTORE
PLUS HERE ONEPLUS RFROM CMOVE')
Word(`pnumber',`\050number\051',`BEGIN ONEPLUS DUP TOR CFETCH BASE FETCH
DIGIT WHILE SWAP BASE FETCH USTAR DROP ROT
BASE FETCH USTAR DPLUS
DPL FETCH ONEPLUS IF ONE DPL PLUSSTORE
ENDIF RFROM REPEAT RFROM')
Word(`number',,`ZERO ZERO ROT DUP ONEPLUS CFETCH LIT(0X2D) EQUALS DUP TOR
PLUS LIT(-1) BEGIN DPL STORE PNUMBER DUP CFETCH BL SUBTRACT
WHILE DUP CFETCH LIT(0X2E) SUBTRACT ZERO QERROR
ZERO REPEAT DROP RFROM IF DMINUS ENDIF')
Word(`dashfind',`-find',`BL WORD HERE CONTEXT FETCH FETCH PFIND
DUP ZEROEQUALS IF DROP HERE LATEST PFIND ENDIF')
Word(`pabort',`\050abort\051',`ABORT')
constants
Word(`errornumber',`error#',`(cell) &errno')
nucleus
Word(`error',,`WARNING FETCH ZEROLESS IF PABORT ENDIF HERE COUNT TYPE
DOTQUOTE(" ? ") MESSAGE SPSTORE IN FETCH BLK FETCH QUIT')